# -*- tcl -*-
# # ## ### ##### ######## ############# #####################
##
# Test suite for Tcl/Hwloc binding.
# Main API, topology creation/destruction, and configuration of the
# creation process.

# # ## ### ##### ######## ############# #####################
## Requirements

package require Tcl 8.5

if {[catch {package require tcltest 2}]} {
    puts stderr "Skipping tests in [info script].  tcltest 2 required."
    return
}

# # ## ### ##### ######## ############# #####################

test hwloc-create-1.0 {wrong\#args} -body {
    hwloc create
} -returnCodes error \
    -result {wrong # args: should be "hwloc create name ?arg? ..."}

# # ## ### ##### ######## ############# #####################

test hwloc-create-2.0 {basic creation} -body {
    hwloc create X
} -cleanup {
    X destroy
} -result ::X

test hwloc-create-2.1 {basic creation, collision check} -body {
    proc X {} {}
    hwloc create X
} -cleanup {
    rename X {}
} -returnCodes error \
    -result {command "::X" already exists, unable to create topology}

test hwloc-create-2.2 {proper destruction, instance method} -setup {
    hwloc create X
} -body {
    lappend res [info commands ::X]
    X destroy
    lappend res [info commands ::X]
    set res
} -cleanup {
    unset res
} -result {::X {}}

test hwloc-create-2.3 {proper destruction, instance renaming} -setup {
    hwloc create X
} -body {
    lappend res [info commands ::X]
    rename X {}
    lappend res [info commands ::X]
    set res
} -cleanup {
    unset res
} -result {::X {}}

# # ## ### ##### ######## ############# #####################

test hwloc-create-3.0 {creation, bogus option} -body {
    hwloc create X -foo
} -returnCodes error \
    -result {bad option "-foo": must be -ignore_all_keep_structure, -ignore_type, -ignore_type_keep_structure, -flags, -fsroot, -pid, -synthetic, or -xml}

foreach {n option arg} {
    1 -ignore_type                type
    2 -ignore_type_keep_structure type
    3 -flags                  flags
    4 -fsroot                 path
    5 -pid                    pid
    6 -synthetic              description
    7 -xml                    path
} {
    test hwloc-create-3.$n {creation, option wrong\#args} -body {
	hwloc create X $option
    } -returnCodes error \
	-result "wrong # args: should be \"hwloc create X $option $arg\""
}

# # ## ### ##### ######## ############# #####################

test hwloc-create-4.0 {creation, ignore all, keep structure } -body {
    hwloc create X -ignore_all_keep_structure
} -cleanup {
    X destroy
} -result ::X

# # ## ### ##### ######## ############# #####################

test hwloc-create-4.1.0 {creation, ignore type, bogus type} -body {
    hwloc create X -ignore_type bogus
} -returnCodes error \
    -result {bad element type "bogus": must be system, machine, numanode, socket, cache, core, pu, group, or misc}

test hwloc-create-4.1.1 {creation, ignore type, can't ignore PU, error} -body {
    hwloc create X -ignore_type pu
} -returnCodes error \
    -result {hwloc_topology_ignore_type() failed}

test hwloc-create-4.1.2 {creation, ignore type, can't ignore root type, no error} -setup {
    hwloc create Z
    set rtype [Z type 0]
    Z destroy
} -body {
    hwloc create X -ignore_type $rtype
} -cleanup {
    X destroy
    unset rtype
} -result ::X

test hwloc-create-4.1.3 {creation, ignore type} -body {
    hwloc create X -ignore_type cache
} -cleanup {
    X destroy
} -result ::X

# # ## ### ##### ######## ############# #####################

test hwloc-create-4.2.0 {creation, ignore type, keep structure, can't ignore PU, error} -body {
    hwloc create X -ignore_type_keep_structure pu
} -returnCodes error \
    -result {hwloc_topology_ignore_type_keep_structure() failed}

test hwloc-create-4.2.1 {creation, ignore type, keep structure, can't ignore root type, no error} -setup {
    hwloc create Z
    set rtype [Z type 0]
    Z destroy
} -body {
    hwloc create X -ignore_type_keep_structure $rtype
} -cleanup {
    X destroy
    unset rtype
} -result ::X

test hwloc-create-4.2.2 {creation, ignore type, keep structure} -body {
    hwloc create X -ignore_type_keep_structure cache
} -cleanup {
    X destroy
} -result ::X

# # ## ### ##### ######## ############# #####################

test hwloc-create-4.3.0 {creation, flags, bad flag} -body {
    hwloc create X -flags foo
} -returnCodes error \
    -result {bad flag "foo": must be this_system or whole_system}

test hwloc-create-4.3.1 {creation, flags, no flags} -body {
    hwloc create X -flags {}
} -cleanup {
    X destroy
} -result ::X

test hwloc-create-4.3.2.0 {creation, flags, this_system effect} -body {
    hwloc create X -flags this_system -synthetic pu:4
    X local
} -cleanup {
    X destroy
} -result 1

test hwloc-create-4.3.2.1 {creation, flags, this_system effect} -body {
    hwloc create X -flags {} -synthetic pu:4
    X local
} -cleanup {
    X destroy
} -result 0

test hwloc-create-4.3.3 {creation, flags, whole_system} -body {
    hwloc create X -flags whole_system
} -cleanup {
    X destroy
} -result ::X

test hwloc-create-4.3.4 {creation, flags, multiple flags} -body {
    hwloc create X -flags {this_system whole_system}
} -cleanup {
    X destroy
} -result ::X

test hwloc-create-4.3.5 {creation, flags, multiple flags, replicated} -body {
    hwloc create X -flags {this_system whole_system this_system}
} -cleanup {
    X destroy
} -result ::X

# # ## ### ##### ######## ############# #####################

test hwloc-create-4.4.0 {creation, fs root, empty path} -body {
    hwloc create X -fsroot {}
} -returnCodes error \
    -result {directory doesn't exist or lacks read permission}

test hwloc-create-4.4.1 {creation, fs root, bad path} -body {
    hwloc create X -fsroot /BOGUS
} -returnCodes error \
    -result {directory doesn't exist or lacks read permission}

test hwloc-create-4.4.2 {creation, fs root, empty dir} -setup {
    set path [tcltest::makeDirectory foo/bar]
} -body {
    hwloc create X -fsroot $path
} -cleanup {
    tcltest::removeDirectory foo/bar
    tcltest::removeDirectory foo
    unset path
    X destroy
} -result ::X

# # ## ### ##### ######## ############# #####################

test hwloc-create-4.5 {creation, pid, self} -body {
    hwloc create X -pid [pid]
} -cleanup {
    X destroy
} -result ::X

# # ## ### ##### ######## ############# #####################

test hwloc-create-4.6.0 {creation, synthetic, nothing}  -body {
    hwloc create X -synthetic {}
} -returnCodes error \
    -result {Expected synthetic topology description, got ""}

# TODO: How to disable libhwloc output to stdout ?
test hwloc-create-4.6.1 {creation, synthetic, bad syntax} -body {
    hwloc create X -synthetic {dsd 24590 dk}
} -returnCodes error \
    -result {hwloc_topology_set_synthetic() failed}

test hwloc-create-4.6.2 {creation, synthetic} -body {
    hwloc create X -synthetic pu:4
} -cleanup {
    X destroy
} -result ::X

# # ## ### ##### ######## ############# #####################

test hwloc-create-4.7.0 {creation, xml, nothing} -body {
    hwloc create X -xml {}
} -returnCodes error -result {file doesn't exist or lacks read permission}

# TODO: How to disable libhwloc output to stdout ?
test hwloc-create-4.7.1 {creation, xml, bad syntax} -setup {
    set temp [tcltest::makeFile {fjkl;df0954 90245-} badtopo]
} -body {
    hwloc create X -xml $temp
} -cleanup {
    tcltest::removeFile badtopo
} -returnCodes error \
    -result {hwloc_topology_set_xml() failed}

test hwloc-create-4.7.2 {creation, xml, bad path} -setup {
} -body {
    hwloc create X -xml bogus
} -returnCodes error \
    -result {file doesn't exist or lacks read permission}

test hwloc-create-4.7.3 {creation, xml} -setup {
    set path $tcltest::testsDirectory/topology1.xml
} -body {
    hwloc create X -xml $path
} -cleanup {
    unset path
    X destroy
} -result ::X

# # ## ### ##### ######## ############# #####################
tcltest::cleanupTests
